home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / MAINBAR.PRG < prev    next >
Encoding:
Text File  |  1990-06-16  |  24.4 KB  |  1,175 lines
  1. **********************************************************************
  2. * Program......: MAINBAR.PRG
  3. * Author.......: Bruce Troutman
  4. * Date.........: 1-04-89
  5. * Notice.......: Interco International, Ltd.
  6. * dBASE Ver....: dBase IV
  7. * Generated by.: APGEN version 1.0
  8. * Description..: Main Menu for Job Cost System
  9.  
  10. * Description..: Menu actions
  11. **********************************************************************
  12. PROCEDURE MAINBAR
  13. PARAMETER entryflg
  14. PRIVATE gc_prognum
  15. gc_prognum="01"
  16.  
  17. DO SET01
  18. IF gn_error > 0
  19.    gn_error=0
  20.    RETURN
  21. ENDIF
  22.  
  23. *-- Before menu code
  24. SET NEAR ON
  25. @ 0,0
  26. TEXT
  27.  
  28.                           J O B   C O S T   S Y S T E M
  29. ENDTEXT
  30. @ 1,20 to 3,60 DOUBLE
  31.  
  32.  
  33. ACTIVATE MENU MAINBAR
  34.  
  35. @ 4,1 CLEAR TO 6,77
  36.  
  37. *-- After menu
  38. SET NEAR OFF
  39.  
  40. RETURN
  41. *-- EOP MAINBAR
  42.  
  43. PROCEDURE SET01
  44. ON KEY LABEL F1 DO 1HELP1
  45.  
  46. DO DBF01 && open menu level database
  47.  
  48. IF gn_error = 0
  49.    IF ISCOLOR()
  50.       SET COLOR OF NORMAL TO W+/B
  51.       SET COLOR OF MESSAGES TO W+/N
  52.       SET COLOR OF TITLES TO W/B
  53.       SET COLOR OF HIGHLIGHT TO B/W
  54.       SET COLOR OF BOX TO B/W
  55.       SET COLOR OF INFORMATION TO B/W
  56.       SET COLOR OF FIELDS TO B/W
  57.    ENDIF
  58.  
  59.    SET BORDER TO
  60.    @ 4,1 TO 6,77 DOUBLE COLOR B/W
  61.    @ 5,2 CLEAR TO 5,76
  62.    @ 5,2 FILL TO 5,76 COLOR W+/N
  63.    @ 5,5 SAY "Data Entry" COLOR W+/N
  64.    @ 5,28 SAY "Retrieval" COLOR W+/N
  65.    @ 5,50 SAY "Other Options" COLOR W+/N
  66.    @ 5,72 SAY "Exit" COLOR W+/N
  67.    @ 22,00
  68. ENDIF
  69. RETURN
  70.  
  71. PROCEDURE DBF01
  72. CLOSE DATABASES
  73. *-- Open menu level view/database
  74. lc_message="0"
  75. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  76. USE TIME
  77. ON ERROR
  78. gn_error=VAL(lc_message)
  79. IF gn_error > 0
  80.    DO Pause WITH ;
  81.    "Error opening TIME.DBF"
  82.    lc_new='Y'
  83.    RETURN
  84. ENDIF
  85. lc_new='Y'
  86. RELEASE lc_message
  87. RETURN
  88.  
  89. PROCEDURE ACT01
  90. *-- Begin MAINBAR: BAR Menu Actions.
  91. *-- (before item, action, and after item)
  92. *
  93. PRIVATE lc_new, lc_dbf
  94. lc_new=' '
  95. lc_dbf=' '
  96. DO CASE
  97. CASE "PAD_1" = PAD()
  98.    lc_new='Y'
  99.    DO DATAENT WITH " 01"
  100. CASE "PAD_2" = PAD()
  101.    lc_new='Y'
  102.    DO DATARET WITH " 01"
  103. CASE "PAD_3" = PAD()
  104.    lc_new='Y'
  105.    DO OTHEROPT WITH " 01"
  106. CASE "PAD_4" = PAD()
  107.    *-- Return to caller
  108.    gc_quit='Q'
  109.    DEACTIVATE MENU && MAINBAR
  110.    RETURN
  111. OTHERWISE
  112.    @ 24,00
  113.    @ 24,21 SAY "This item has no action. Press a key."
  114.    x=INKEY(0)
  115.    @ 24,00
  116. ENDCASE
  117. SET MESSAGE TO
  118. IF SET("STATUS")="ON"
  119.    SET STATUS OFF
  120. ENDIF
  121. IF gc_quit='Q'
  122.    DEACTIVATE MENU && MAINBAR
  123. ENDIF
  124. IF lc_new='Y'
  125.    lc_file="SET"+gc_prognum
  126.    DO &lc_file.
  127. ENDIF
  128. RETURN
  129. **********************************************************************
  130. * Program......: DATAENT.PRG
  131. * Author.......: Bruce Troutman
  132. * Date.........: 1-04-89
  133. * Notice.......: Interco International, Ltd.
  134. * dBASE Ver....: dBase IV
  135. * Generated by.: APGEN version 1.0
  136. * Description..: Data Entry Menu for Job Cost System
  137.  
  138. * Description..: Menu actions
  139. **********************************************************************
  140. PROCEDURE DATAENT
  141. PARAMETER entryflg
  142. PRIVATE gc_prognum
  143. gc_prognum="02"
  144.  
  145. DO SET02
  146. IF gn_error > 0
  147.    gn_error=0
  148.    RETURN
  149. ENDIF
  150.  
  151. *-- Before menu code
  152.  
  153.  
  154. ACTIVATE POPUP DATAENT
  155.  
  156. *-- After menu
  157.  
  158. RETURN
  159. *-- EOP DATAENT
  160.  
  161. PROCEDURE SET02
  162. ON KEY LABEL F1 DO 1HELP1
  163.  
  164. IF gn_error = 0
  165.    IF ISCOLOR()
  166.       SET COLOR OF NORMAL TO W+/B
  167.       SET COLOR OF MESSAGES TO W+/N
  168.       SET COLOR OF TITLES TO W/B
  169.       SET COLOR OF HIGHLIGHT TO B/W
  170.       SET COLOR OF BOX TO B/W
  171.       SET COLOR OF INFORMATION TO B/W
  172.       SET COLOR OF FIELDS TO B/W
  173.    ENDIF
  174.    @ 22,00
  175. ENDIF
  176. RETURN
  177.  
  178. PROCEDURE ACT02
  179. *-- Begin DATAENT: POPUP Menu Actions.
  180. *-- (before item, action, and after item)
  181. *
  182. PRIVATE lc_new, lc_dbf
  183. lc_new=' '
  184. lc_dbf=' '
  185. DO CASE
  186. CASE BAR() = 1
  187.    ACTIVATE WINDOW Savescr
  188.    SET SCOREBOARD ON
  189.    SET MESSAGE TO "Time Slip File Manager"
  190.    DO TIME
  191.  
  192.    SET SCOREBOARD OFF
  193.    DEACTIVATE WINDOW Savescr
  194.    close databases
  195. CASE BAR() = 2
  196.    ACTIVATE WINDOW Savescr
  197.    SET SCOREBOARD ON
  198.    SET MESSAGE TO "Job File Manager"
  199.    DO JOB
  200.  
  201.    SET SCOREBOARD OFF
  202.    DEACTIVATE WINDOW Savescr
  203. CASE BAR() = 3
  204.    ACTIVATE WINDOW Savescr
  205.    SET SCOREBOARD ON
  206.    SET MESSAGE TO "Customer File Manager"
  207.    DO CUSTOMER
  208.  
  209.    SET SCOREBOARD OFF
  210.    DEACTIVATE WINDOW Savescr
  211. CASE BAR() = 4
  212.    ACTIVATE WINDOW Savescr
  213.    SET SCOREBOARD ON
  214.    SET MESSAGE TO "Employee File Manager"
  215.    DO EMP
  216.  
  217.    SET SCOREBOARD OFF
  218.    DEACTIVATE WINDOW Savescr
  219. CASE BAR() = 5
  220.    ACTIVATE WINDOW Savescr
  221.    SET SCOREBOARD ON
  222.    SET MESSAGE TO "Billing Rate File Manager"
  223.    DO EMPRATE
  224.  
  225.    SET SCOREBOARD OFF
  226.    DEACTIVATE WINDOW Savescr
  227. CASE BAR() = 6
  228.    ACTIVATE WINDOW Savescr
  229.    SET SCOREBOARD ON
  230.    SET MESSAGE TO "Function Code File Manager"
  231.    DO FUNCODE
  232.  
  233.    SET SCOREBOARD OFF
  234.    DEACTIVATE WINDOW Savescr
  235. ENDCASE
  236. SET MESSAGE TO
  237. IF SET("STATUS")="ON"
  238.    SET STATUS OFF
  239. ENDIF
  240. IF gc_quit='Q'
  241.    DEACTIVATE POPUP && DATAENT
  242. ENDIF
  243. IF lc_new='Y'
  244.    lc_file="SET"+gc_prognum
  245.    DO &lc_file.
  246. ENDIF
  247. RETURN
  248. **********************************************************************
  249. * Program......: DATARET.PRG
  250. * Author.......: Bruce Troutman
  251. * Date.........: 1-04-89
  252. * Notice.......: Interco International, Ltd.
  253. * dBASE Ver....: dBase IV
  254. * Generated by.: APGEN version 1.0
  255. * Description..: Data Retrieval Menu for Job Cost System
  256.  
  257. * Description..: Menu actions
  258. **********************************************************************
  259. PROCEDURE DATARET
  260. PARAMETER entryflg
  261. PRIVATE gc_prognum
  262. gc_prognum="03"
  263.  
  264. DO SET03
  265. IF gn_error > 0
  266.    gn_error=0
  267.    RETURN
  268. ENDIF
  269.  
  270. *-- Before menu code
  271.  
  272.  
  273. ACTIVATE POPUP DATARET
  274.  
  275. *-- After menu
  276.  
  277. RETURN
  278. *-- EOP DATARET
  279.  
  280. PROCEDURE SET03
  281. ON KEY LABEL F1 DO 1HELP1
  282.  
  283. DO DBF03 && open menu level database
  284.  
  285. IF gn_error = 0
  286.    IF ISCOLOR()
  287.       SET COLOR OF NORMAL TO W+/B
  288.       SET COLOR OF MESSAGES TO W+/N
  289.       SET COLOR OF TITLES TO W/B
  290.       SET COLOR OF HIGHLIGHT TO B/W
  291.       SET COLOR OF BOX TO B/W
  292.       SET COLOR OF INFORMATION TO B/W
  293.       SET COLOR OF FIELDS TO B/W
  294.    ENDIF
  295.    @ 22,00
  296. ENDIF
  297. RETURN
  298.  
  299. PROCEDURE DBF03
  300. CLOSE DATABASES
  301. *-- Open menu level view/database
  302. lc_message="0"
  303. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  304. USE TIME
  305. ON ERROR
  306. gn_error=VAL(lc_message)
  307. IF gn_error > 0
  308.    DO Pause WITH ;
  309.    "Error opening TIME.DBF"
  310.    lc_new='Y'
  311.    RETURN
  312. ENDIF
  313. lc_new='Y'
  314. RELEASE lc_message
  315. RETURN
  316.  
  317. PROCEDURE ACT03
  318. *-- Begin DATARET: POPUP Menu Actions.
  319. *-- (before item, action, and after item)
  320. *
  321. PRIVATE lc_new, lc_dbf
  322. lc_new=' '
  323. lc_dbf=' '
  324. DO CASE
  325. CASE BAR() = 1
  326.    lc_new='Y'
  327.    DO REPORTS WITH " 03"
  328. CASE BAR() = 2
  329.    lc_new='Y'
  330.    DO REVIEW WITH " 03"
  331. CASE BAR() = 3
  332.    lc_new='Y'
  333.    DO LABELS WITH " 03"
  334. CASE BAR() = 4
  335.    *-- Open Item level view/database and indexes
  336.    CLOSE DATABASES
  337.    lc_dbf='Y'
  338.    lc_message="0"
  339.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  340.    SET VIEW TO INVOICE.QBE
  341.    ON ERROR
  342.    gn_error=VAL(lc_message)
  343.    IF gn_error > 0
  344.       DO Pause WITH ;
  345.       "Error opening INVOICE.QBE"
  346.       gn_error=0
  347.       lc_file="SET"+gc_prognum
  348.       DO &lc_file.
  349.       RETURN
  350.    ENDIF
  351.    lc_new='Y'
  352.    RELEASE lc_message
  353.    ACTIVATE WINDOW Savescr
  354.    SET MESSAGE TO "Produce Invoices"
  355.    *-- Desc: Report
  356.    gn_pkey = 0
  357.    DO PrintSet
  358.    IF gn_pkey <> 27  && esc
  359.       REPORT FORM INVOICE PLAIN  NOEJECT 
  360.       DO Cleanup
  361.    ENDIF
  362.    DEACTIVATE WINDOW Savescr
  363. ENDCASE
  364. SET MESSAGE TO
  365. IF SET("STATUS")="ON"
  366.    SET STATUS OFF
  367. ENDIF
  368. IF gc_quit='Q'
  369.    DEACTIVATE POPUP && DATARET
  370. ENDIF
  371. IF lc_new='Y'
  372.    lc_file="SET"+gc_prognum
  373.    DO &lc_file.
  374. ENDIF
  375. IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
  376.    lc_file="DBF"+gc_prognum
  377.    DO &lc_file.
  378. ENDIF
  379. RETURN
  380. **********************************************************************
  381. * Program......: OTHEROPT.PRG
  382. * Author.......: Bruce Troutman
  383. * Date.........: 1-04-89
  384. * Notice.......: Interco International, Ltd.
  385. * dBASE Ver....: dBase IV
  386. * Generated by.: APGEN version 1.0
  387. * Description..: Other Options Menu
  388.  
  389. * Description..: Menu actions
  390. **********************************************************************
  391. PROCEDURE OTHEROPT
  392. PARAMETER entryflg
  393. PRIVATE gc_prognum
  394. gc_prognum="04"
  395.  
  396. DO SET04
  397. IF gn_error > 0
  398.    gn_error=0
  399.    RETURN
  400. ENDIF
  401.  
  402. *-- Before menu code
  403.  
  404.  
  405. ACTIVATE POPUP OTHEROPT
  406.  
  407. *-- After menu
  408.  
  409. RETURN
  410. *-- EOP OTHEROPT
  411.  
  412. PROCEDURE SET04
  413. ON KEY LABEL F1 DO 1HELP1
  414.  
  415. DO DBF04 && open menu level database
  416.  
  417. IF gn_error = 0
  418.    IF ISCOLOR()
  419.       SET COLOR OF NORMAL TO W+/B
  420.       SET COLOR OF MESSAGES TO W+/N
  421.       SET COLOR OF TITLES TO W/B
  422.       SET COLOR OF HIGHLIGHT TO B/W
  423.       SET COLOR OF BOX TO B/W
  424.       SET COLOR OF INFORMATION TO B/W
  425.       SET COLOR OF FIELDS TO B/W
  426.    ENDIF
  427.    @ 22,00
  428. ENDIF
  429. RETURN
  430.  
  431. PROCEDURE DBF04
  432. CLOSE DATABASES
  433. *-- Open menu level view/database
  434. lc_message="0"
  435. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  436. USE TIME
  437. ON ERROR
  438. gn_error=VAL(lc_message)
  439. IF gn_error > 0
  440.    DO Pause WITH ;
  441.    "Error opening TIME.DBF"
  442.    lc_new='Y'
  443.    RETURN
  444. ENDIF
  445. lc_new='Y'
  446. RELEASE lc_message
  447. RETURN
  448.  
  449. PROCEDURE ACT04
  450. *-- Begin OTHEROPT: POPUP Menu Actions.
  451. *-- (before item, action, and after item)
  452. *
  453. PRIVATE lc_new, lc_dbf
  454. lc_new=' '
  455. lc_dbf=' '
  456. DO CASE
  457. CASE BAR() = 1
  458.    ACTIVATE WINDOW Savescr
  459.    SET SCOREBOARD ON
  460.    SET MESSAGE TO "Back Up Data Files"
  461.    DO BACKUP
  462.  
  463.    SET SCOREBOARD OFF
  464.    DEACTIVATE WINDOW Savescr
  465. CASE BAR() = 2
  466.    *-- Open Item level view/database and indexes
  467.    CLOSE DATABASES
  468.    lc_dbf='Y'
  469.    lc_message="0"
  470.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  471.    USE TIME
  472.    ON ERROR
  473.    gn_error=VAL(lc_message)
  474.    IF gn_error > 0
  475.       DO Pause WITH ;
  476.       "Error opening TIME.DBF"
  477.       gn_error=0
  478.       lc_file="SET"+gc_prognum
  479.       DO &lc_file.
  480.       RETURN
  481.    ENDIF
  482.    lc_new='Y'
  483.    RELEASE lc_message
  484.    *-- Multi user file lock
  485.    DO Lockit WITH "1"
  486.    IF gn_error <> 0
  487.       gn_error=0
  488.       RETURN
  489.    ENDIF
  490.    ACTIVATE WINDOW Savescr
  491.    SET MESSAGE TO "Create Lotus File: TIME.WKS"
  492.    lc_say='Copying records to TIME.WKS'
  493.    DO info_box WITH lc_say
  494.    SET TALK ON
  495.    *--  Desc: Copy records to TIME.WKS
  496.    COPY TO TIME.WKS TYPE WKS
  497.    SET TALK OFF
  498.  
  499.    DEACTIVATE WINDOW Savescr
  500.    IF NETWORK()
  501.       UNLOCK
  502.    ENDIF
  503. CASE BAR() = 3
  504.    *-- Open Item level view/database and indexes
  505.    CLOSE DATABASES
  506.    lc_dbf='Y'
  507.    lc_message="0"
  508.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  509.    USE EMP
  510.    IF "" <> DBF()
  511.       SET INDEX TO EMP
  512.    ENDIF
  513.    SET ORDER TO NAME
  514.    ON ERROR
  515.    gn_error=VAL(lc_message)
  516.    IF gn_error > 0
  517.       DO Pause WITH ;
  518.       "Error opening EMP.DBF or index(es) EMP"
  519.       gn_error=0
  520.       lc_file="SET"+gc_prognum
  521.       DO &lc_file.
  522.       RETURN
  523.    ENDIF
  524.    lc_new='Y'
  525.    RELEASE lc_message
  526.    *-- Multi user file lock
  527.    DO Lockit WITH "1"
  528.    IF gn_error <> 0
  529.       gn_error=0
  530.       RETURN
  531.    ENDIF
  532.    ACTIVATE WINDOW Savescr
  533.    SET MESSAGE TO "Create Employee List ASCII File: EMP.TXT"
  534.    lc_say='Copying records to EMP.TXT'
  535.    DO info_box WITH lc_say
  536.    SET TALK ON
  537.    *--  Desc: Copy records to EMP.TXT
  538.    COPY TO EMP.TXT FIELDS fname,lname,address,city,state,zip,phone TYPE SDF
  539.    SET TALK OFF
  540.  
  541.    DEACTIVATE WINDOW Savescr
  542.    IF NETWORK()
  543.       UNLOCK
  544.    ENDIF
  545. CASE BAR() = 4
  546.    ACTIVATE WINDOW Savescr
  547.    SET SCOREBOARD ON
  548.    SET MESSAGE TO "Go to DOS Command Prompt. Type EXIT to Return to Job Cost System."
  549.    *-- Desc: Inline DO dBASE commands
  550.    RUN COMMAND
  551.    SET SCOREBOARD OFF
  552.    DEACTIVATE WINDOW Savescr
  553. ENDCASE
  554. SET MESSAGE TO
  555. IF SET("STATUS")="ON"
  556.    SET STATUS OFF
  557. ENDIF
  558. IF gc_quit='Q'
  559.    DEACTIVATE POPUP && OTHEROPT
  560. ENDIF
  561. IF lc_new='Y'
  562.    lc_file="SET"+gc_prognum
  563.    DO &lc_file.
  564. ENDIF
  565. IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
  566.    lc_file="DBF"+gc_prognum
  567.    DO &lc_file.
  568. ENDIF
  569. RETURN
  570. **********************************************************************
  571. * Program......: REPORTS.PRG
  572. * Author.......: Bruce Troutman
  573. * Date.........: 1-04-89
  574. * Notice.......: Interco International, Ltd.
  575. * dBASE Ver....: dBase IV
  576. * Generated by.: APGEN version 1.0
  577. * Description..: Reports Menu for Job Cost System
  578.  
  579. * Description..: Menu actions
  580. **********************************************************************
  581. PROCEDURE REPORTS
  582. PARAMETER entryflg
  583. PRIVATE gc_prognum
  584. gc_prognum="05"
  585.  
  586. DO SET05
  587. IF gn_error > 0
  588.    gn_error=0
  589.    RETURN
  590. ENDIF
  591.  
  592. *-- Before menu code
  593.  
  594.  
  595. ACTIVATE POPUP REPORTS
  596.  
  597. *-- After menu
  598.  
  599. RETURN
  600. *-- EOP REPORTS
  601.  
  602. PROCEDURE SET05
  603. ON KEY LABEL F1 DO 1HELP1
  604.  
  605. DO DBF05 && open menu level database
  606.  
  607. IF gn_error = 0
  608.    IF ISCOLOR()
  609.       SET COLOR OF NORMAL TO W+/B
  610.       SET COLOR OF MESSAGES TO W+/N
  611.       SET COLOR OF TITLES TO W/B
  612.       SET COLOR OF HIGHLIGHT TO B/W
  613.       SET COLOR OF BOX TO B/W
  614.       SET COLOR OF INFORMATION TO B/W
  615.       SET COLOR OF FIELDS TO B/W
  616.    ENDIF
  617.    @ 22,00
  618. ENDIF
  619. RETURN
  620.  
  621. PROCEDURE DBF05
  622. CLOSE DATABASES
  623. *-- Open menu level view/database
  624. lc_message="0"
  625. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  626. USE TIME
  627. ON ERROR
  628. gn_error=VAL(lc_message)
  629. IF gn_error > 0
  630.    DO Pause WITH ;
  631.    "Error opening TIME.DBF"
  632.    lc_new='Y'
  633.    RETURN
  634. ENDIF
  635. lc_new='Y'
  636. RELEASE lc_message
  637. RETURN
  638.  
  639. PROCEDURE ACT05
  640. *-- Begin REPORTS: POPUP Menu Actions.
  641. *-- (before item, action, and after item)
  642. *
  643. PRIVATE lc_new, lc_dbf
  644. lc_new=' '
  645. lc_dbf=' '
  646. DO CASE
  647. CASE BAR() = 1
  648.    *-- Open Item level view/database and indexes
  649.    CLOSE DATABASES
  650.    lc_dbf='Y'
  651.    lc_message="0"
  652.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  653.    SET VIEW TO JOBSTAT.QBE
  654.    ON ERROR
  655.    gn_error=VAL(lc_message)
  656.    IF gn_error > 0
  657.       DO Pause WITH ;
  658.       "Error opening JOBSTAT.QBE"
  659.       gn_error=0
  660.       lc_file="SET"+gc_prognum
  661.       DO &lc_file.
  662.       RETURN
  663.    ENDIF
  664.    lc_new='Y'
  665.    RELEASE lc_message
  666.    ACTIVATE WINDOW Savescr
  667.    SET MESSAGE TO "Produce Job Status Report for Incomplete Jobs"
  668.    *-- Desc: Report
  669.    gn_pkey = 0
  670.    DO PrintSet
  671.    IF gn_pkey <> 27  && esc
  672.       REPORT FORM JOBSTAT PLAIN 
  673.       DO Cleanup
  674.    ENDIF
  675.    DEACTIVATE WINDOW Savescr
  676. CASE BAR() = 2
  677.    *-- Open Item level view/database and indexes
  678.    CLOSE DATABASES
  679.    lc_dbf='Y'
  680.    lc_message="0"
  681.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  682.    USE EMP
  683.    IF "" <> DBF()
  684.       SET INDEX TO EMP
  685.    ENDIF
  686.    SET ORDER TO NAME
  687.    ON ERROR
  688.    gn_error=VAL(lc_message)
  689.    IF gn_error > 0
  690.       DO Pause WITH ;
  691.       "Error opening EMP.DBF or index(es) EMP"
  692.       gn_error=0
  693.       lc_file="SET"+gc_prognum
  694.       DO &lc_file.
  695.       RETURN
  696.    ENDIF
  697.    lc_new='Y'
  698.    RELEASE lc_message
  699.    ACTIVATE WINDOW Savescr
  700.    SET MESSAGE TO "Produce Employee Phone List Report"
  701.    *-- Desc: Report
  702.    gn_pkey = 0
  703.    DO PrintSet
  704.    IF gn_pkey <> 27  && esc
  705.       REPORT FORM EMP PLAIN 
  706.       DO Cleanup
  707.    ENDIF
  708.    DEACTIVATE WINDOW Savescr
  709. CASE BAR() = 5
  710.    *-- Open Item level view/database and indexes
  711.    CLOSE DATABASES
  712.    lc_dbf='Y'
  713.    lc_message="0"
  714.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  715.    USE FUNCODE
  716.    IF "" <> DBF()
  717.       SET INDEX TO FUNCODE
  718.    ENDIF
  719.    SET ORDER TO FUNCODE
  720.    ON ERROR
  721.    gn_error=VAL(lc_message)
  722.    IF gn_error > 0
  723.       DO Pause WITH ;
  724.       "Error opening FUNCODE.DBF or index(es) FUNCODE"
  725.       gn_error=0
  726.       lc_file="SET"+gc_prognum
  727.       DO &lc_file.
  728.       RETURN
  729.    ENDIF
  730.    lc_new='Y'
  731.    RELEASE lc_message
  732.    ACTIVATE WINDOW Savescr
  733.    SET MESSAGE TO "Produce Function Code List"
  734.    *-- Desc: List [<parameters>]
  735.    CLEAR
  736.    gn_pkey = 0
  737.    DO PrintSet
  738.    IF gn_pkey <> 27  && esc
  739.       DISPLAY ALL OFF
  740.       DO Cleanup
  741.    ENDIF
  742.    DEACTIVATE WINDOW Savescr
  743. ENDCASE
  744. SET MESSAGE TO
  745. IF SET("STATUS")="ON"
  746.    SET STATUS OFF
  747. ENDIF
  748. IF gc_quit='Q'
  749.    DEACTIVATE POPUP && REPORTS
  750. ENDIF
  751. IF lc_new='Y'
  752.    lc_file="SET"+gc_prognum
  753.    DO &lc_file.
  754. ENDIF
  755. IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
  756.    lc_file="DBF"+gc_prognum
  757.    DO &lc_file.
  758. ENDIF
  759. RETURN
  760. **********************************************************************
  761. * Program......: REVIEW.PRG
  762. * Author.......: Bruce Troutman
  763. * Date.........: 1-04-89
  764. * Notice.......: Interco International, Ltd.
  765. * dBASE Ver....: dBase IV
  766. * Generated by.: APGEN version 1.0
  767. * Description..: Review Menu for Job Cost System
  768.  
  769. * Description..: Menu actions
  770. **********************************************************************
  771. PROCEDURE REVIEW
  772. PARAMETER entryflg
  773. PRIVATE gc_prognum
  774. gc_prognum="06"
  775.  
  776. DO SET06
  777. IF gn_error > 0
  778.    gn_error=0
  779.    RETURN
  780. ENDIF
  781.  
  782. *-- Before menu code
  783.  
  784.  
  785. ACTIVATE POPUP REVIEW
  786.  
  787. *-- After menu
  788.  
  789. RETURN
  790. *-- EOP REVIEW
  791.  
  792. PROCEDURE SET06
  793. ON KEY LABEL F1 DO 1HELP1
  794.  
  795. DO DBF06 && open menu level database
  796.  
  797. IF gn_error = 0
  798.    IF ISCOLOR()
  799.       SET COLOR OF NORMAL TO W+/B
  800.       SET COLOR OF MESSAGES TO W+/N
  801.       SET COLOR OF TITLES TO W/B
  802.       SET COLOR OF HIGHLIGHT TO B/W
  803.       SET COLOR OF BOX TO B/W
  804.       SET COLOR OF INFORMATION TO B/W
  805.       SET COLOR OF FIELDS TO B/W
  806.    ENDIF
  807.    @ 22,00
  808. ENDIF
  809. RETURN
  810.  
  811. PROCEDURE DBF06
  812. CLOSE DATABASES
  813. *-- Open menu level view/database
  814. lc_message="0"
  815. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  816. USE TIME
  817. ON ERROR
  818. gn_error=VAL(lc_message)
  819. IF gn_error > 0
  820.    DO Pause WITH ;
  821.    "Error opening TIME.DBF"
  822.    lc_new='Y'
  823.    RETURN
  824. ENDIF
  825. lc_new='Y'
  826. RELEASE lc_message
  827. RETURN
  828.  
  829. PROCEDURE ACT06
  830. *-- Begin REVIEW: POPUP Menu Actions.
  831. *-- (before item, action, and after item)
  832. *
  833. PRIVATE lc_new, lc_dbf
  834. lc_new=' '
  835. lc_dbf=' '
  836. DO CASE
  837. CASE BAR() = 1
  838.    *-- Open Item level view/database and indexes
  839.    CLOSE DATABASES
  840.    lc_dbf='Y'
  841.    lc_message="0"
  842.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  843.    SET VIEW TO EMPPROG.QBE
  844.    ON ERROR
  845.    gn_error=VAL(lc_message)
  846.    IF gn_error > 0
  847.       DO Pause WITH ;
  848.       "Error opening EMPPROG.QBE"
  849.       gn_error=0
  850.       lc_file="SET"+gc_prognum
  851.       DO &lc_file.
  852.       RETURN
  853.    ENDIF
  854.    lc_new='Y'
  855.    RELEASE lc_message
  856.    lc_new='Y'
  857.    DO PROGFLDS WITH " 06"
  858. CASE BAR() = 2
  859.    *-- Open Item level view/database and indexes
  860.    CLOSE DATABASES
  861.    lc_dbf='Y'
  862.    lc_message="0"
  863.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  864.    SET VIEW TO EMPRATE.QBE
  865.    ON ERROR
  866.    gn_error=VAL(lc_message)
  867.    IF gn_error > 0
  868.       DO Pause WITH ;
  869.       "Error opening EMPRATE.QBE"
  870.       gn_error=0
  871.       lc_file="SET"+gc_prognum
  872.       DO &lc_file.
  873.       RETURN
  874.    ENDIF
  875.    lc_new='Y'
  876.    RELEASE lc_message
  877.    ACTIVATE WINDOW Browscr
  878.    SET SCOREBOARD ON
  879.    SET MESSAGE TO "Employees and their Billing Rates"
  880.    *-- Desc: Browse file - EMPRATE.QBE
  881.    BROWSE NOAPPEND NODELETE NOEDIT 
  882.    SET SCOREBOARD OFF
  883.    DEACTIVATE WINDOW Browscr
  884. ENDCASE
  885. SET MESSAGE TO
  886. IF SET("STATUS")="ON"
  887.    SET STATUS OFF
  888. ENDIF
  889. IF gc_quit='Q'
  890.    DEACTIVATE POPUP && REVIEW
  891. ENDIF
  892. IF lc_new='Y'
  893.    lc_file="SET"+gc_prognum
  894.    DO &lc_file.
  895. ENDIF
  896. IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
  897.    lc_file="DBF"+gc_prognum
  898.    DO &lc_file.
  899. ENDIF
  900. RETURN
  901. **********************************************************************
  902. * Program......: LABELS.PRG
  903. * Author.......: Bruce Troutman
  904. * Date.........: 1-04-89
  905. * Notice.......: Interco International, Ltd.
  906. * dBASE Ver....: dBase IV
  907. * Generated by.: APGEN version 1.0
  908. * Description..: Labels Menu
  909.  
  910. * Description..: Menu actions
  911. **********************************************************************
  912. PROCEDURE LABELS
  913. PARAMETER entryflg
  914. PRIVATE gc_prognum
  915. gc_prognum="07"
  916.  
  917. DO SET07
  918. IF gn_error > 0
  919.    gn_error=0
  920.    RETURN
  921. ENDIF
  922.  
  923. *-- Before menu code
  924.  
  925.  
  926. ACTIVATE POPUP LABELS
  927.  
  928. *-- After menu
  929.  
  930. RETURN
  931. *-- EOP LABELS
  932.  
  933. PROCEDURE SET07
  934. ON KEY LABEL F1 DO 1HELP1
  935.  
  936. DO DBF07 && open menu level database
  937.  
  938. IF gn_error = 0
  939.    IF ISCOLOR()
  940.       SET COLOR OF NORMAL TO W+/B
  941.       SET COLOR OF MESSAGES TO W+/N
  942.       SET COLOR OF TITLES TO W/B
  943.       SET COLOR OF HIGHLIGHT TO B/W
  944.       SET COLOR OF BOX TO B/W
  945.       SET COLOR OF INFORMATION TO B/W
  946.       SET COLOR OF FIELDS TO B/W
  947.    ENDIF
  948.    @ 22,00
  949. ENDIF
  950. RETURN
  951.  
  952. PROCEDURE DBF07
  953. CLOSE DATABASES
  954. *-- Open menu level view/database
  955. lc_message="0"
  956. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  957. USE TIME
  958. ON ERROR
  959. gn_error=VAL(lc_message)
  960. IF gn_error > 0
  961.    DO Pause WITH ;
  962.    "Error opening TIME.DBF"
  963.    lc_new='Y'
  964.    RETURN
  965. ENDIF
  966. lc_new='Y'
  967. RELEASE lc_message
  968. RETURN
  969.  
  970. PROCEDURE ACT07
  971. *-- Begin LABELS: POPUP Menu Actions.
  972. *-- (before item, action, and after item)
  973. *
  974. PRIVATE lc_new, lc_dbf
  975. lc_new=' '
  976. lc_dbf=' '
  977. DO CASE
  978. CASE BAR() = 1
  979.    *-- Open Item level view/database and indexes
  980.    CLOSE DATABASES
  981.    lc_dbf='Y'
  982.    lc_message="0"
  983.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  984.    USE EMP
  985.    SET ORDER TO NAME
  986.    ON ERROR
  987.    gn_error=VAL(lc_message)
  988.    IF gn_error > 0
  989.       DO Pause WITH ;
  990.       "Error opening EMP.DBF"
  991.       gn_error=0
  992.       lc_file="SET"+gc_prognum
  993.       DO &lc_file.
  994.       RETURN
  995.    ENDIF
  996.    lc_new='Y'
  997.    RELEASE lc_message
  998.    ACTIVATE WINDOW Savescr
  999.    SET MESSAGE TO "Produce Mailing Labels for Employees"
  1000.    *--  Desc: LABEL command to call EMP
  1001.    gn_pkey = 0
  1002.    DO PrintSet
  1003.    IF gn_pkey <> 27  && esc
  1004.       LABEL FORM EMP FOR ACTIVE
  1005.       DO Cleanup
  1006.    ENDIF
  1007.    DEACTIVATE WINDOW Savescr
  1008. CASE BAR() = 2
  1009.    *-- Open Item level view/database and indexes
  1010.    CLOSE DATABASES
  1011.    lc_dbf='Y'
  1012.    lc_message="0"
  1013.    ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  1014.    USE CUSTOMER
  1015.    IF "" <> DBF()
  1016.       SET INDEX TO CUSTOMER
  1017.    ENDIF
  1018.    SET ORDER TO CUSTNAME
  1019.    ON ERROR
  1020.    gn_error=VAL(lc_message)
  1021.    IF gn_error > 0
  1022.       DO Pause WITH ;
  1023.       "Error opening CUSTOMER.DBF or index(es) CUSTOMER"
  1024.       gn_error=0
  1025.       lc_file="SET"+gc_prognum
  1026.       DO &lc_file.
  1027.       RETURN
  1028.    ENDIF
  1029.    lc_new='Y'
  1030.    RELEASE lc_message
  1031.    ACTIVATE WINDOW Savescr
  1032.    SET MESSAGE TO "Produce Mailing Labels for Customers"
  1033.    *--  Desc: LABEL command to call CUSTOMER
  1034.    gn_pkey = 0
  1035.    DO PrintSet
  1036.    IF gn_pkey <> 27  && esc
  1037.       LABEL FORM CUSTOMER
  1038.       DO Cleanup
  1039.    ENDIF
  1040.    DEACTIVATE WINDOW Savescr
  1041. ENDCASE
  1042. SET MESSAGE TO
  1043. IF SET("STATUS")="ON"
  1044.    SET STATUS OFF
  1045. ENDIF
  1046. IF gc_quit='Q'
  1047.    DEACTIVATE POPUP && LABELS
  1048. ENDIF
  1049. IF lc_new='Y'
  1050.    lc_file="SET"+gc_prognum
  1051.    DO &lc_file.
  1052. ENDIF
  1053. IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
  1054.    lc_file="DBF"+gc_prognum
  1055.    DO &lc_file.
  1056. ENDIF
  1057. RETURN
  1058. **********************************************************************
  1059. * Program......: PROGFLDS.PRG
  1060. * Author.......: Bruce Troutman
  1061. * Date.........: 1-04-89
  1062. * Notice.......: Interco International, Ltd.
  1063. * dBASE Ver....: dBase IV
  1064. * Generated by.: APGEN version 1.0
  1065. * Description..: Fields for PROG Dept View
  1066.  
  1067. * Description..: Menu actions
  1068. **********************************************************************
  1069. PROCEDURE PROGFLDS
  1070. PARAMETER entryflg
  1071. PRIVATE gc_prognum
  1072. gc_prognum="08"
  1073.  
  1074. IF LEFT(entryflg,1)="A"
  1075.    DO ACT08
  1076.    RETURN
  1077. ENDIF
  1078.  
  1079. DO SET08
  1080. IF gn_error > 0
  1081.    gn_error=0
  1082.    RETURN
  1083. ENDIF
  1084.  
  1085. *-- Before menu code
  1086.  
  1087. lc_fldlst=''
  1088. ON KEY LABEL CTRL-W DEACTIVATE POPUP
  1089. IF TYPE("lc_window")="U"
  1090.    DEFINE WINDOW ShowPick FROM 17,0 TO 21,60 DOUBLE
  1091.    ACTIVATE WINDOW ShowPick
  1092. ENDIF
  1093. ACTIVATE SCREEN
  1094.  
  1095. ACTIVATE POPUP PROGFLDS
  1096.  
  1097. IF TYPE("lc_window")="U"
  1098.    DEACTIVATE WINDOW ShowPick
  1099.    RELEASE WINDOW ShowPick
  1100. ENDIF
  1101. ON KEY LABEL CTRL-W
  1102. IF RIGHT(lc_fldlst,1)=","
  1103.    listval=LEFT(lc_fldlst,LEN(lc_fldlst)-1)
  1104.    DO ACT08
  1105. ENDIF
  1106.  
  1107. *-- After menu
  1108.  
  1109. gn_ikey=27
  1110. RETURN
  1111. *-- EOP PROGFLDS
  1112.  
  1113. PROCEDURE SET08
  1114. ON KEY LABEL F1 DO 1HELP1
  1115.  
  1116. DO DBF08 && open menu level database
  1117.  
  1118. IF gn_error = 0
  1119.    IF ISCOLOR()
  1120.       SET COLOR OF NORMAL TO W+/B
  1121.       SET COLOR OF MESSAGES TO W+/N
  1122.       SET COLOR OF TITLES TO W/B
  1123.       SET COLOR OF HIGHLIGHT TO B/W
  1124.       SET COLOR OF BOX TO B/W
  1125.       SET COLOR OF INFORMATION TO B/W
  1126.       SET COLOR OF FIELDS TO B/W
  1127.    ENDIF
  1128. ENDIF
  1129. RETURN
  1130.  
  1131. PROCEDURE DBF08
  1132. CLOSE DATABASES
  1133. *-- Open menu level view/database
  1134. lc_message="0"
  1135. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  1136. SET VIEW TO EMPPROG.QBE
  1137. ON ERROR
  1138. gn_error=VAL(lc_message)
  1139. IF gn_error > 0
  1140.    DO Pause WITH ;
  1141.    "Error opening EMPPROG.QBE"
  1142.    lc_new='Y'
  1143.    RETURN
  1144. ENDIF
  1145. lc_new='Y'
  1146. RELEASE lc_message
  1147. RETURN
  1148.  
  1149. PROCEDURE ACT08
  1150. *-- Begin PROGFLDS: STRUCTURE Menu Actions.
  1151. *-- (before item, action, and after item)
  1152. *
  1153. PRIVATE lc_new, lc_dbf
  1154. lc_new=' '
  1155. lc_dbf=' '
  1156. ACTIVATE WINDOW Browscr
  1157. SET SCOREBOARD ON
  1158. SET MESSAGE TO "Review Employees in the Programming Department"
  1159. *-- Desc: Browse file - 
  1160. BROWSE FIELDS &listval 
  1161. SET SCOREBOARD OFF
  1162. DEACTIVATE WINDOW Browscr
  1163. SET MESSAGE TO
  1164. IF SET("STATUS")="ON"
  1165.    SET STATUS OFF
  1166. ENDIF
  1167. IF gc_quit='Q'
  1168.    DEACTIVATE POPUP && PROGFLDS
  1169. ENDIF
  1170. IF lc_new='Y'
  1171.    lc_file="SET"+gc_prognum
  1172.    DO &lc_file.
  1173. ENDIF
  1174. RETURN
  1175.